home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / editdemo / vbinput.bas < prev   
BASIC Source File  |  1995-05-09  |  22KB  |  727 lines
  1. '(c) 1991 by Keith Milligan
  2. '            100 Lee Road 605
  3. '            Smiths, AL 36877
  4. '            205-291-9712 Home
  5. '            205-298-1974 Work
  6. '            Compuserve ID = 70645,520
  7.  
  8. 'Use these routines if they will help you.  You can use,
  9. 'modify, copy, or distribute with a clear concience.
  10.  
  11. 'Visual Basic 1.0 input routines
  12.  
  13. 'These routine are use two events for each text control.
  14. 'There is a Sub for the KeyPress event and a corresponding
  15. 'Function for the LostFocus Event.  The KeyPress (KP) routine
  16. 'restricts certain keystrokes and the LostFocus (LF) routine
  17. 'validates the data entered in the text control and assigns
  18. 'the entered data to a variable.
  19.  
  20. 'Date
  21. '  Sub DateKP(ThisControl, KeyAscii)
  22. '  Function  DateLF$(ThisControl, EarliestDate$)
  23. '  Format of EarliestDate$ is "yymmdd".
  24. '  Accepts date enter in one of the following formats:
  25. '     60491, 060491, 06/04/91, or 6/4/91
  26. '  Returns date in the format 910604.
  27.  
  28. 'MultPrice
  29. '  Sub MultPriceKP(ThisControl, KeyAscii)
  30. '  Function MultPriceLF$(ThisControl)
  31. '  Used to accept retail prices.  For example 3 for $1.00.
  32. '  Accepts and returns in the following formats:
  33. '    Input          Returns
  34. '     149           01/01.49
  35. '     1.49          01/01.49
  36. '     3/49          03/00.49
  37. '     3/.49         03/00.49
  38.  
  39. 'Point2
  40. '  Sub Point2KP(ThisControl, Length%, KeyAscii)
  41. '  Function Point2LF(ThisControl, Min#, Max#)
  42. '  Accepts number with two digits to the right of the decimal point.
  43. '  Maximum length = Length%
  44. '  Minimum value = Min#
  45. '  Maximum value = Max#
  46. '  Example 123.49
  47.  
  48. 'Point4
  49. '  Sub Point4KP(ThisControl, Length%, KeyAscii)
  50. '  Function Point4LF(ThisControl, Min#, Max#)
  51. '  Accepts number with four digits to the right of the decimal point.
  52. '  Maximum length = Length%
  53. '  Minimum value = Min#
  54. '  Maximum value = Max#
  55. '  Example 123.4978
  56.  
  57. 'Str
  58. '  Sub StrKP(ThisControl, Length%, KeyAscii)
  59. '  No LF function for this routine just move text to string in
  60. '    LostFocus Event.
  61. '  Accepts string of length less than or equal to Length%.
  62.  
  63. 'UCStr
  64. '  Sub UCStrKP(ThisControl, Length%, KeyAscii)
  65. '  No LF function for this routine just move text to string in
  66. '    LostFocus Event.
  67. '  Accepts string of length less than or equal to Length%.
  68. '  Converts characters to upper case as typed.
  69.  
  70. 'Long
  71. '  Sub LongKP(ThisControl, Length%, KeyAscii)
  72. '  Function LongLF&(ThisControl, Min&, Max&)
  73. '  Accepts long integer amount.
  74.  
  75. 'Int
  76. '  Sub IntKP(ThisControl, Length%, KeyAscii)
  77. '  Function IntLF%(ThisControl, Min%, Max%)
  78. '  Same as Long but accepts normal integer amounts
  79.  
  80. 'Curr2
  81. '  Sub Curr2KP(ThisControl, Length%, KeyAscii)
  82. '  Function Curr2LF@(ThisControl, Min@, Max@)
  83. '  Same as Point2 but for currency data type.
  84.  
  85. 'Curr4
  86. '  Sub Curr4KP(ThisControl, Length%, KeyAscii)
  87. '  Function Curr4LF(ThisControl, Min@, Max@)
  88. '  Same as Point4 but for currency data type.
  89.  
  90. 'DateSer
  91. '  Sub DateSerKP(Thiscontrol, KeyAscii)
  92. '  Function DateSerLF@(ThisControl, EarliestDate$)
  93. '  Same as Date but returns date serial number instead of yymmdd.
  94.  
  95. '
  96.  
  97. Sub Curr2KP (ThisControl As Control, Length%, KeyAscii As Integer)
  98.     If Len(ThisControl.Text) = Length% Then
  99.       If KeyAscii <> 8 Then
  100.         KeyAscii = 0
  101.         Beep
  102.       End If
  103.     Else
  104.       C$ = Chr$(KeyAscii)
  105.       StringLength% = Len(ThisControl.Text)
  106.       DecimalPosition% = InStr(ThisControl.Text, ".")
  107.       If StringLength% - DecimalPosition% = 2 And DecimalPosition% <> 0 Then
  108.         If ThisControl.SelStart < DecimalPosition% Then
  109.           Select Case C$
  110.             Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  111.             Case "-"
  112.               If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  113.                 KeyAscii = 0
  114.                 Beep
  115.               End If
  116.             Case Else
  117.               KeyAscii = 0
  118.               Beep
  119.           End Select
  120.         ElseIf KeyAscii <> 8 Then
  121.           KeyAscii = 0
  122.           Beep
  123.         End If
  124.       Else
  125.         Select Case C$
  126.           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  127.           Case "."
  128.             If InStr(ThisControl.Text, ".") <> 0 Then
  129.               KeyAscii = 0
  130.               Beep
  131.             End If
  132.           Case "-"
  133.             If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  134.               KeyAscii = 0
  135.               Beep
  136.             End If
  137.           Case Else
  138.             KeyAscii = 0
  139.             Beep
  140.         End Select
  141.       End If
  142.     End If
  143. End Sub
  144.  
  145. Function Curr2LF@ (ThisControl As Control, Min@, Max@)
  146.   Test@ = Val(ThisControl.Text)
  147.   If ThisControl.Text <> "" Then
  148.     If Test@ < Min@ Or Test@ > Max@ Then
  149.       Beep
  150.       Msg$ = "Number must be between " + Str$(Min@) + " and " + Str$(Max@)
  151.       MsgBox Msg$, 0, "Warning"
  152.       ThisControl.SetFocus
  153.     Else
  154.       Curr2LF@ = Test@
  155.     End If
  156.   End If
  157.  
  158. End Function
  159.  
  160. Sub Curr4KP (ThisControl As Control, Length%, KeyAscii As Integer)
  161.     If Len(ThisControl.Text) = Length% Then
  162.       If KeyAscii <> 8 Then
  163.         KeyAscii = 0
  164.         Beep
  165.       End If
  166.     Else
  167.       C$ = Chr$(KeyAscii)
  168.       StringLength% = Len(ThisControl.Text)
  169.       DecimalPosition% = InStr(ThisControl.Text, ".")
  170.       If StringLength% - DecimalPosition% = 4 And DecimalPosition% <> 0 Then
  171.         If ThisControl.SelStart < DecimalPosition% Then
  172.           Select Case C$
  173.             Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  174.             Case "-"
  175.               If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  176.                 KeyAscii = 0
  177.                 Beep
  178.               End If
  179.             Case Else
  180.               KeyAscii = 0
  181.               Beep
  182.           End Select
  183.         ElseIf KeyAscii <> 8 Then
  184.           KeyAscii = 0
  185.           Beep
  186.         End If
  187.       Else
  188.         Select Case C$
  189.           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8)
  190.           Case "."
  191.             If InStr(ThisControl.Text, ".") <> 0 Then
  192.               KeyAscii = 0
  193.               Beep
  194.             End If
  195.           Case "-"
  196.             If ThisControl.SelStart <> 0 Or InStr(ThisControl.Text, "-") <> 0 Then
  197.               KeyAscii = 0
  198.               Beep
  199.             End If
  200.           Case Else
  201.             KeyAscii = 0
  202.             Beep
  203.         End Select
  204.       End If
  205.     End If
  206. End Sub
  207.  
  208. Function Curr4LF (ThisControl As Control, Min@, Max@)
  209.   Test@ = Val(ThisControl.Text)
  210.   If ThisControl.Text <> "" Then
  211.     If Test@ < Min@ Or Test@ > Max@ Then
  212.       Beep
  213.       Msg$ = "Number must be between " + Str$(Min@) + " and " + Str$(Max@)
  214.       MsgBox Msg$, 0, "Warning"
  215.       ThisControl.SetFocus
  216.     Else
  217.       Curr4LF! = Test@
  218.     End If
  219.   End If
  220.  
  221. End Function
  222.  
  223. Sub DateKP (ThisControl As Control, KeyAscii As Integer)
  224.     C$ = Chr$(KeyAscii)
  225.     Test$ = ThisControl.Text
  226.     If Len(Test$) = 6 And InStr(Test$, "/") = 0 Then
  227.       If KeyAscii <> 8 Then
  228.         KeyAscii = 0
  229.         Beep
  230.       End If
  231.     ElseIf Len(Test$) = 8 And InStr(Test$, "/") <> 0 Then
  232.       If KeyAscii <> 8 Then
  233.         KeyAscii = 0
  234.         Beep
  235.       End If
  236.     Else
  237.         Select Case C$
  238.           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", Chr$(8), "/"
  239.           Case Else
  240.             KeyAscii = 0
  241.             Beep
  242.         End Select
  243.     End If
  244. End Sub
  245.  
  246. Function DateLF$ (ThisControl As Control, EarliestDate$)
  247.   If ThisControl.Text <> "" Then
  248.     BadDate$ = "N"
  249.     InDate$ = ThisControl.Text
  250.     If Len(InDate$) = 5 Then
  251.       InDate$ = "0" + InDate$
  252.     ElseIf Len(InDate$) = 6 Then
  253.       If InStr(InDate$, "/") <> 0 Then
  254.         InDate$ = "0" + Left$(InDate$, 1) + "0" + Mid$(InDate$, 3, 1) + Mid$(InDate$, 5, 2)
  255.       End If
  256.     ElseIf Len(InDate$) = 7 Then
  257.       If Mid$(InDate$, 2, 1) = "/" Then
  258.         InDate$ = "0" + Left$(InDate$, 1) + Mid$(InDate$, 3, 2) + Mid$(InDate$, 6, 2)
  259.       Else
  260.         InDate$ = Left$(InDate$, 2) + "0" + Mid$(InDate$, 4, 1) + Mid$(InDate$, 6, 2)
  261.       End If
  262.     ElseIf Len(InDate$) = 8 Then
  263.       InDate$ = Left$(InDate$, 2) + Mid$(InDate$, 4, 2) + Mid$(InDate